perm filename CYCDRD.LSP[3,LMM] blob sn#037473 filedate 1973-04-21 generic text, type T, neo UTF8

(DEFPROP CYCDRDFNS
 (CYCDRDFNS RTLIN)
VALUE)

(DEFPROP RTLIN
 (LAMBDA(RI X L1)
  (PROG	(X1 X2 Y1 Y2 N1 N2 Y SL IN Z)
	(COND ((NULL L1) (RETURN T)))
	(SETQ N1 (CAAR X))
	(SETQ N2 (CDAR X))
	(SETQ X1 (NODE N1))
	(SETQ X2 (NODE N2))
	(SETQ Y1 (NODE (PLUS N1 20.)))
	(SETQ Y2 (NODE (PLUS N2 20.)))
	(SETQ SL (SLOPE X1 X2 Y1 Y2))
	(SETQ IN (YINTCP X1 X2 Y1 Y2))
	(RETURN
	 (FOR Y
	      IN
	      L1
	      AS
	      Z
	      IS
	      (CONCT X Y)
	      AS
	      N1
	      IS
	      (CAAR Y)
	      AS
	      N2
	      IS
	      (CDAR Y)
	      AND
	      ((LAMBDA(A1 A2 B1 B2)
		(PROG (SL2 X YT2)
		      (SETQ SL2 (SLOPE A1 A2 B1 B2))
		      (SETQ X (DIFFERENCE (TIMES (CAR SL) (CDR SL2)) (TIMES (CAR SL2) (CDR SL))))
		      (COND ((ZEROP X) (GO A)) (Z (RETURN T)) (RI (RETURN T)))
		      (SETQ X
			    (PROG (V1 V2)
				  (SETQ V1 (DIFFERENCE X2 X1))
				  (SETQ V2 (DIFFERENCE A2 A1))
				  (RETURN
				   (CONS (DIFFERENCE (TIMES (DIFFERENCE (TIMES B1 A2) (TIMES A1 B2)) V1)
						     (TIMES (DIFFERENCE (TIMES Y1 X2) (TIMES X1 Y2)) V2))
					 (DIFFERENCE (TIMES (DIFFERENCE Y2 Y1) V2)
						     (TIMES (DIFFERENCE B2 B1) V1))))))
		      (COND ((EQ X1 X2) (GO C))
			    ((EQ A1 A2) (GO B))
			    (T (RETURN (AND (CLCINTA X A1 A2) (CLCINTA X X1 X2)))))
		 B    (COND ((CLCINTA X X1 X2) (RETURN T)))
		      (SETQ X
			    (PROG (V1 V2)
				  (SETQ V1 (DIFFERENCE Y2 Y1))
				  (SETQ V2 (DIFFERENCE B2 B1))
				  (RETURN
				   (CONS (DIFFERENCE (TIMES (DIFFERENCE (TIMES A1 B2) (TIMES B1 A2)) V1)
						     (TIMES (DIFFERENCE (TIMES X1 Y2) (TIMES Y1 X2)) V2))
					 (DIFFERENCE (TIMES (DIFFERENCE X2 X1) V2)
						     (TIMES (DIFFERENCE A2 A1) V1))))))
		      (RETURN (CLCINTA X B1 B2))
		 C    (COND ((CLCINTA X A1 A2) (RETURN T)))
		      (SETQ X
			    (PROG (V1 V2)
				  (SETQ V1 (DIFFERENCE Y2 Y1))
				  (SETQ V2 (DIFFERENCE B2 B1))
				  (RETURN
				   (CONS (DIFFERENCE (TIMES (DIFFERENCE (TIMES A1 B2) (TIMES B1 A2)) V1)
						     (TIMES (DIFFERENCE (TIMES X1 Y2) (TIMES Y1 X2)) V2))
					 (DIFFERENCE (TIMES (DIFFERENCE X2 X1) V2)
						     (TIMES (DIFFERENCE A2 A1) V1))))))
		      (RETURN (CLCINTA X Y1 Y2))
		 A    (SETQ YT2 (YINTCP A1 A2 B1 B2))
		      (SETQ X (DIFFERENCE (TIMES (CAR IN) (CDR YT2)) (TIMES (CAR YT2) (CDR IN))))
		      (COND
		       ((OR (NOT (ZEROP X)) (AND (ZEROP (CDR IN)) (ZEROP (CDR YT2)) (NOT (EQ X1 A1))))
			(RETURN T)))
		      (RETURN
		       (COND ((EQ X1 X2) (OR (GEQ (MIN Y1 Y2) (MAX B1 B2)) (GEQ (MIN B1 B2) (MAX Y1 Y2))))
			     (T (OR (GEQ (MIN X1 X2) (MAX A1 A2)) (GEQ (MIN A1 A2) (MAX X1 X2))))))))
	       (NODE N1)
	       (NODE N2)
	       (NODE (PLUS N1 20.))
	       (NODE (PLUS N2 20.)))))))
EXPR)